home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol285 / menu.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1987-03-15  |  9.7 KB  |  308 lines
  1. 100  REM MENU Program
  2. 110  REM Menu of the available Genealogy Programs.
  3. 120  REM Copyright (c) 1983 - 1987 by: Melvin O. Duke.
  4. 130  DEFINT A-Z
  5. 200  REM Screen Definitions
  6. 210  S1 = 0      'Set Text Mode
  7. 220  S2 = 1      'Enable Color
  8. 230  S3 = 0      'Active Page
  9. 240  S4 = 0      'Visual Page
  10. 250  WIDTH "scrn:",80
  11. 260  SCREEN S1, S2, S3, S4
  12. 300  REM Color Definitions
  13. 310  K = 0       'blacK
  14. 320  N = 1       'blue (Navy or uNderline)
  15. 330  G = 2       'Green
  16. 340  B = 3       'cyan (light Blue)
  17. 350  R = 4       'Red
  18. 360  P = 5       'magenta (Purple)
  19. 370  O = 6       'brown (Orange)
  20. 380  W = 7       'White
  21. 400  REM Disk Definitions
  22. 410  DD.MENU$   = "a:\"
  23. 420  DD.VERI$   = "a:\"
  24. 430  DD.PROG$   = "a:\"
  25. 440  DD.PERS$   = "a:\"
  26. 450  DD.MARR$   = "a:\"
  27. 460  DD.ORD$    = "a:\"
  28. 470  DD.PCIDX$  = "a:\"
  29. 480  DD.MARIDX$ = "a:\"
  30. 500  REM Printer Definitions
  31. 510  FORM.FEED$    = CHR$(12)
  32. 520  PAP.SENS.ON$  = CHR$(27)+"9"
  33. 530  PAP.SENS.OFF$ = CHR$(27)+"8"
  34. 540  PAP.LONG$     = CHR$(27)+"C"+CHR$(66)
  35. 550  PAP.SHORT$    = CHR$(27)+"C"+CHR$(51)
  36. 560  COMPR.ON$     = CHR$(15)
  37. 570  COMPR.OFF$    = CHR$(18)
  38. 580  BOLD.ON$      = CHR$(27)+"E"
  39. 590  BOLD.OFF$     = CHR$(27)+"F"
  40. 600  REM Constants
  41. 610  MAX.PER = 500
  42. 620  MAX.MAR = 200
  43. 630  OLD.MAX.PER = 0
  44. 640  OLD.MAX.MAR = 0
  45. 650  MAX.GEN = 30        'For DESCEND
  46. 660  MAX.LINES = 58      'For DESCEND
  47. 670  CHART.NOS$ = "n"
  48. 680  START.PER = 1
  49. 690  START.MAR = 1
  50. 700  '
  51. 710  LEFT.SPACE = 18     'For FAMILY
  52. 720  BEGIN.LTR$ = "A"
  53. 730  END.LTR$   = "Z"
  54. 740  MALE.LTR$   = "M" : MALE.SEX$   = "Male"
  55. 750  FEMALE.LTR$ = "F" : FEMALE.SEX$ = "Female"
  56. 760  WIDE   = 1  'narrow
  57. 770  LENGTH = 2  'long
  58. 780  FORMS  = 1  'continuous
  59. 800  REM Function Key Settings
  60. 810  KEY 1, ""
  61. 820  KEY 2, ""
  62. 830  KEY 3, ""
  63. 840  KEY 4, ""
  64. 850  KEY 5, ""
  65. 860  KEY 6, ""
  66. 870  KEY 7, ""
  67. 880  KEY 8, ""
  68. 890  KEY 9, ""
  69. 900  KEY 10, ""
  70. 1000  REM Titles
  71. 1010  TITLE$ = "MENU of Programs in Genealogy"
  72. 1020  TITLE$ = TITLE$ + " ON DISPLAY"
  73. 1030  VERSION$ = "Version 5.0"
  74. 1040  COPY1$ = "Copyright (c) 1983 thru 1987, by:"
  75. 1050  COPY2$ = "Melvin O. Duke"
  76. 1060  PRICE$ = "$45"
  77. 1070  ADDR1$ = "Melvin O. Duke"
  78. 1080  ADDR2$ = "P. O. Box 20836"
  79. 1090  ADDR3$ = "San Jose, CA  95160"
  80. 1100  REM Make sure that BASIC was invoked with /s:256
  81. 1110  ON ERROR GOTO 1170
  82. 1120  OPEN DD.VERI$+"verifile" AS #1 LEN = 256
  83. 1130  ON ERROR GOTO 0
  84. 1140  FIELD 1, 128 AS DUMY1$, 128 AS DUMY2$
  85. 1150  CLOSE
  86. 1160  GOTO 1300
  87. 1170  IF ERR = 5 THEN 1180 ELSE ON ERROR GOTO 0 : GOTO 1120
  88. 1180  REM File Buffer less than 256 bytes
  89. 1190  KEY ON : CLS : LOCATE 10,1 : COLOR R,B
  90. 1200  PRINT "BASIC must be brought up with /s:256, for Genealogy Records."
  91. 1210  PRINT "Program has been Terminated."
  92. 1220  PRINT "Enter CONT to return to DOS"
  93. 1230  COLOR W,K : STOP
  94. 1240  SYSTEM
  95. 1300  REM Produce the first screen
  96. 1310  KEY ON : CLS : KEY OFF
  97. 1320  REM Draw the outer double box
  98. 1330  R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 1600
  99. 1340  REM Find the title location
  100. 1350  TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  101. 1360  REM Draw the title box
  102. 1370  R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 1800
  103. 1380  REM Print the title
  104. 1390  LOCATE 4,TITLE.POS : PRINT TITLE$
  105. 1400  LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  106. 1410  REM Draw the Contribution box
  107. 1420  R1 = 7 : C1 = 18 : R2 = 17 : C2 = 61 : GOSUB 1600
  108. 1430  REM Request the Contribution
  109. 1440  LOCATE  8,20 : PRINT "If you are using these programs, you are"
  110. 1450  LOCATE  9,21 : PRINT "expected to become a Registered User,"
  111. 1460  LOCATE 10,20 : PRINT "by making a contribution to the author"
  112. 1470  LOCATE 11,23 : PRINT "of the programs ("+PRICE$+" suggested)."
  113. 1480  REM Draw the Mailing Label
  114. 1490  R1 = 12 : C1 = 28 : R2 = 16 : C2 = 52 : GOSUB 1800
  115. 1500  REM Print the Name and Address
  116. 1510  LOCATE 13,40-INT(LEN(ADDR1$)/2) :  PRINT ADDR1$;
  117. 1520  LOCATE 14,40-INT(LEN(ADDR2$)/2) :  PRINT ADDR2$;
  118. 1530  LOCATE 15,40-INT(LEN(ADDR3$)/2) :  PRINT ADDR3$;
  119. 1540  REM Draw the Copyright box
  120. 1550  R1 = 19 : C1 = 21 : R2 = 22 : C2 = 59 : GOSUB 1600
  121. 1560  REM Print the Copyright
  122. 1570  LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  123. 1580  LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  124. 1590  GOTO 1940
  125. 1600  REM subroutine to print a double box
  126. 1610  COLOR P
  127. 1620  FOR I = R1 + 1 TO R2 - 1
  128. 1630   LOCATE I, C1 : PRINT CHR$(186);
  129. 1640   LOCATE I, C2 : PRINT CHR$(186);
  130. 1650  NEXT I
  131. 1660  LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,205);
  132. 1670  LOCATE R2, C1+1 : PRINT STRING$(C2-C1-1,205);
  133. 1680   LOCATE R1, C1 : PRINT CHR$(201);
  134. 1690   LOCATE R1, C2 : PRINT CHR$(187);
  135. 1700   LOCATE R2, C1 : PRINT CHR$(200);
  136. 1710   LOCATE R2, C2 : PRINT CHR$(188);
  137. 1720  COLOR W
  138. 1730  RETURN
  139. 1800  REM subroutine to print a single box
  140. 1810  COLOR B
  141. 1820  FOR I = R1 + 1 TO R2 - 1
  142. 1830   LOCATE I, C1 : PRINT CHR$(179);
  143. 1840   LOCATE I, C2 : PRINT CHR$(179);
  144. 1850  NEXT I
  145. 1860  LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,196);
  146. 1870  LOCATE R2, C1+1 : PRINT STRING$(C2-C1-1,196);
  147. 1880   LOCATE R1, C1 : PRINT CHR$(218);
  148. 1890   LOCATE R1, C2 : PRINT CHR$(191);
  149. 1900   LOCATE R2, C1 : PRINT CHR$(192);
  150. 1910   LOCATE R2, C2 : PRINT CHR$(217);
  151. 1920  COLOR W
  152. 1930  RETURN
  153. 1940  REM ask user to press a key to continue
  154. 1950  LOCATE 25,1
  155. 1960  PRINT "Have Program Diskette in place, then press any key to continue.";
  156. 1970  A$ = INKEY$ : IF A$ = "" THEN 1970
  157. 1980  KEY ON : CLS : KEY OFF
  158. 2000  REM MENU Program Starts Here.
  159. 2010  IF DD.ORD$ = "no\" THEN DD.ORD$ = "no"
  160. 2020  REM Draw the Menu itself.
  161. 2030  REM Draw the Outer Double Box.
  162. 2040  R1 = 1 : C1 = 1 : R2 = 23 : C2 = 79 : GOSUB 1600
  163. 2050  REM Draw the Heading Separator.
  164. 2060  R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 3190
  165. 2070  REM Draw the Vertical Separators.
  166. 2080  R1 = 1 : C1 = 6 : R2 = 23 : C2 = 6 : GOSUB 3260
  167. 2090  R1 = 1 : C1 =17 : R2 = 23 : C2 =17 : GOSUB 3260
  168. 2100  REM Attach the intersections
  169. 2110  COLOR P
  170. 2120  LOCATE 3, 6 : PRINT CHR$(197);
  171. 2130  LOCATE 3,17 : PRINT CHR$(197);
  172. 2140  COLOR W,K
  173. 2150  REM Print the content of the menu.
  174. 2160  COLOR K,W
  175. 2170  LOCATE 2,3 : PRINT "No";
  176. 2180  LOCATE 2,8 : PRINT "Name"
  177. 2190  LOCATE 2,19 : PRINT "Function of the Program"
  178. 2200  COLOR W,K
  179. 2210  COLOR K,W : LOCATE  4,3 : PRINT " 1"; : COLOR R,K
  180. 2220  LOCATE  4,  8 : PRINT "CREATPER";
  181. 2230  LOCATE  4, 19 : PRINT "Creates (FORMATS) a Persons File.";
  182. 2240  COLOR K,W : LOCATE  5,3 : PRINT " 2"; : COLOR R,K
  183. 2250  LOCATE  5,  8 : PRINT "CREATMAR";
  184. 2260  LOCATE  5, 19 : PRINT "Creates (FORMATS) a Marriages File.";
  185. 2270  IF DD.ORD$ = "no" THEN 2280 ELSE 2310
  186. 2280  COLOR R,K
  187. 2290  LOCATE 6,19 : PRINT "  **(Formatting of Ordinance File has been Deleted.)**"
  188. 2300  GOTO 2340
  189. 2310  COLOR K,W : LOCATE  6,3 : PRINT " 3"; : COLOR R,K
  190. 2320  LOCATE  6,  8 : PRINT "CREATORD";
  191. 2330  LOCATE  6, 19 : PRINT "Creates (FORMATS) an Ordinances File.";
  192. 2340  COLOR K,W : LOCATE  7,3 : PRINT " 4"; : COLOR G,K
  193. 2350  LOCATE  7,  8 : PRINT "UPDATPER";
  194. 2360  LOCATE  7, 19 : PRINT "Updates Information in the Persons File."
  195. 2370  COLOR K,W : LOCATE  8,3 : PRINT " 5"; : COLOR G,K
  196. 2380  LOCATE  8,  8 : PRINT "UPDATMAR";
  197. 2390  LOCATE  8, 19 : PRINT "Updates Information in the Marriages File."
  198. 2400  IF DD.ORD$ = "no" THEN 2410 ELSE 2440
  199. 2410  COLOR G,K
  200. 2420  LOCATE 9,19 : PRINT "  **(Updating of Ordinance File has been Deleted.)**"
  201. 2430  GOTO 2470
  202. 2440  COLOR K,W : LOCATE  9,3 : PRINT " 6"; : COLOR G,K
  203. 2450  LOCATE  9,  8 : PRINT "UPDATORD";
  204. 2460  LOCATE  9, 19 : PRINT "Updates Information in the Ordinances File."
  205. 2470  COLOR K,W : LOCATE 10,3 : PRINT " 7"; : COLOR R,K
  206. 2480  LOCATE 10,  8 : PRINT "INDEXPC ";
  207. 2490  LOCATE 10, 19 : PRINT "Prepares a Parent/Child Index.  (For 13, 16, 18 and 19.)";
  208. 2500  COLOR K,W : LOCATE 11,3 : PRINT " 8"; : COLOR R,K
  209. 2510  LOCATE 11,  8 : PRINT "INDEXMAR";
  210. 2520  LOCATE 11, 19 : PRINT "Prepares a Marriages Index.  (For 15, 16, 17, 18 and 19.)";
  211. 2530  COLOR K,W : LOCATE 12,3 : PRINT " 9"; : COLOR O,K
  212. 2540  LOCATE 12,  8 : PRINT "PRINTPER";
  213. 2550  LOCATE 12, 19 : PRINT "Prints Detailed Information about Persons.";
  214. 2560  COLOR K,W : LOCATE 13,3 : PRINT "10"; : COLOR O,K
  215. 2570  LOCATE 13,  8 : PRINT "PRINTMAR";
  216. 2580  LOCATE 13, 19 : PRINT "Prints Detailed Information about Marriages."
  217. 2590  COLOR K,W : LOCATE 14,3 : PRINT "11"; : COLOR O,K
  218. 2600  LOCATE 14,  8 : PRINT "LISTPER ";
  219. 2610  LOCATE 14, 19 : PRINT "Prints a List of the Persons in the Persons File."
  220. 2620  COLOR K,W : LOCATE 15,3 : PRINT "12"; : COLOR O,K
  221. 2630  LOCATE 15,  8 : PRINT "LISTMAR ";
  222. 2640  LOCATE 15, 19 : PRINT "Prints a List of the Marriages in the Marriages File."
  223. 2650  COLOR K,W : LOCATE 16,3 : PRINT "13"; : COLOR O,K
  224. 2660  LOCATE 16,  8 : PRINT "LISTPCI ";
  225. 2670  LOCATE 16, 19 : PRINT "Prints a List of the Parent/Child Index.";
  226. 2680  COLOR K,W : LOCATE 17,3 : PRINT "14"; : COLOR O,K
  227. 2690  LOCATE 17,  8 : PRINT "ALPHAPER";
  228. 2700  LOCATE 17, 19 : PRINT "Prints an Alphabetical List of Persons."
  229. 2710  COLOR K,W : LOCATE 18,3 : PRINT "15"; : COLOR O,K
  230. 2720  LOCATE 18,  8 : PRINT "ALPHAMAR";
  231. 2730  LOCATE 18, 19 : PRINT "Prints an Alphabetical List of Marriages."
  232. 2740  COLOR K,W : LOCATE 19,3 : PRINT "16"; : COLOR B,K
  233. 2750  LOCATE 19,  8 : PRINT "DISPLAY ";
  234. 2760  LOCATE 19, 19 : PRINT "Displays Genealogical Information on the Screen."
  235. 2770  COLOR K,W : LOCATE 20,3 : PRINT "17"; : COLOR G,K
  236. 2780  LOCATE 20,  8 : PRINT "PEDIGREE";
  237. 2790  LOCATE 20, 19 : PRINT "Prints Pedigree Charts (Family Trees)."
  238. 2800  COLOR K,W : LOCATE 21,3 : PRINT "18"; : COLOR G,K
  239. 2810  LOCATE 21,  8 : PRINT "FAMILY  ";
  240. 2820  LOCATE 21, 19 : PRINT "Prints Family Group Sheets."
  241. 2830  COLOR K,W : LOCATE 22,3 : PRINT "19"; : COLOR B,K
  242. 2840  LOCATE 22,  8 : PRINT "DESCEND";
  243. 2850  LOCATE 22, 19 : PRINT "Displays (and Optionally Prints) Descendents Charts."
  244. 2860  COLOR W,K
  245. 2870  REM Now obtain User Response
  246. 2880  LOCATE 25,2 : PRINT "(0 to quit, 20 to restart the MENU)";
  247. 2890  LOCATE 24,1
  248. 2900  LINE INPUT "Type a Program Number, and press the 'enter' key.: "; REPLY$
  249. 2910  IF REPLY$ = "" THEN 1980
  250. 2920  IF REPLY$ = "0" THEN 3350
  251. 2930  REPLY = VAL(REPLY$)
  252. 2940  IF REPLY < 1 OR REPLY > 20 THEN 1980
  253. 2950  IF REPLY =  1 THEN KEY ON : CHAIN DD.PROG$+"creatper",,ALL
  254. 2960  IF REPLY =  2 THEN KEY ON : CHAIN DD.PROG$+"creatmar",,ALL
  255. 2970  IF DD.ORD$ = "no" THEN 2990
  256. 2980  IF REPLY =  3 THEN KEY ON : CHAIN DD.PROG$+"creatord",,ALL
  257. 2990  IF REPLY =  4 THEN KEY ON : CHAIN DD.PROG$+"updatper",,ALL
  258. 3000  IF REPLY =  5 THEN KEY ON : CHAIN DD.PROG$+"updatmar",,ALL
  259. 3010  IF DD.ORD$ = "no" THEN 3030
  260. 3020  IF REPLY =  6 THEN KEY ON : CHAIN DD.PROG$+"updatord",,ALL
  261. 3030  IF REPLY =  7 THEN KEY ON : CHAIN DD.PROG$+"indexpc" ,,ALL
  262. 3040  IF REPLY =  8 THEN KEY ON : CHAIN DD.PROG$+"indexmar",,ALL
  263. 3050  IF REPLY =  9 THEN KEY ON : CHAIN DD.PROG$+"printper",,ALL
  264. 3060  IF REPLY = 10 THEN KEY ON : CHAIN DD.PROG$+"printmar",,ALL
  265. 3070  IF REPLY = 11 THEN KEY ON : CHAIN DD.PROG$+"listper" ,,ALL
  266. 3080  IF REPLY = 12 THEN KEY ON : CHAIN DD.PROG$+"listmar" ,,ALL
  267. 3090  IF REPLY = 13 THEN KEY ON : CHAIN DD.PROG$+"listpci" ,,ALL
  268. 3100  IF REPLY = 14 THEN KEY ON : CHAIN DD.PROG$+"alphaper",,ALL
  269. 3110  IF REPLY = 15 THEN KEY ON : CHAIN DD.PROG$+"alphamar",,ALL
  270. 3120  IF REPLY = 16 THEN KEY ON : CHAIN DD.PROG$+"display" ,,ALL
  271. 3130  IF REPLY = 17 THEN KEY ON : CHAIN DD.PROG$+"pedigree",,ALL
  272. 3140  IF REPLY = 18 THEN KEY ON : CHAIN DD.PROG$+"family"  ,,ALL
  273. 3150  IF REPLY = 19 THEN KEY ON : CHAIN DD.PROG$+"descend" ,,ALL
  274. 3160  IF REPLY = 20 THEN KEY ON : RUN DD.MENU$+"menu"
  275. 3170  REM Improper Response
  276. 3180  GOTO 1980
  277. 3190  REM Subroutine to draw a single horizontal line.  Attach to double.
  278. 3200  COLOR P
  279. 3210  LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,196);
  280. 3220  LOCATE R1,C1 : PRINT CHR$(199);
  281. 3230  LOCATE R1,C2 : PRINT CHR$(182);
  282. 3240  COLOR W
  283. 3250  RETURN
  284. 3260  REM Subroutine to draw a single vertical line.  Attach to double.
  285. 3270  COLOR P
  286. 3280  FOR I = R1 + 1 TO R2 - 1
  287. 3290   LOCATE I,C1 : PRINT CHR$(179);
  288. 3300  NEXT I
  289. 3310  LOCATE R1,C1 : PRINT CHR$(209);
  290. 3320  LOCATE R2,C1 : PRINT CHR$(207);
  291. 3330  COLOR W
  292. 3340  RETURN
  293. 3350  KEY ON : CLS
  294. 3360  REM Reset the Function Keys
  295. 3370  KEY 1, "LIST "
  296. 3380  KEY 2, "RUN"+CHR$(13)
  297. 3390  KEY 3, "LOAD"+CHR$(34)
  298. 3400  KEY 4, "SAVE"+CHR$(34)
  299. 3410  KEY 5, "CONT"+CHR$(13)
  300. 3420  KEY 6, ","+CHR$(34)+"LPT1:"+CHR$(34)+CHR$(13)
  301. 3430  KEY 7, "TRON"+CHR$(13)
  302. 3440  KEY 8, "TROFF"+CHR$(13)
  303. 3450  KEY 9, "KEY "
  304. 3460  KEY 10, "SCREEN 0,0,0"+CHR$(13)
  305. 3470  LOCATE 21,1
  306. 3480  PRINT "End of Program"
  307. 3490  END
  308.